home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 6 / Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso / 038a / aplibs91.zip / MISC-U.BAS < prev    next >
BASIC Source File  |  1991-07-01  |  19KB  |  656 lines
  1.  
  2. '                      ╔════════════════════════════╗
  3. '                      ║                            ║
  4. '                      ║         MISC_U.BAS         ║
  5. '                      ║                            ║
  6. '                      ║   H.B. LIBRARY LEFTOVERS   ║
  7. '                      ║                            ║
  8. '                      ╚════════════════════════════╝
  9.  
  10.  
  11.                             $COMPILE UNIT
  12.                             $ERROR ALL OFF
  13.                             DEFINT A-Z
  14.  
  15.   %False = 0
  16.   %True = NOT %False
  17.   %FLAGS = 0:  %AX = 1:  %BX = 2:  %CX = 3:  %DX = 4
  18.                          %SI = 5:  %DI = 6:  %BP = 7:  %DS = 8:  %ES = 9
  19.  
  20.  %LtButton = 0
  21.  %RtButton = 1
  22.  %ReadMotionCounters = &H0B
  23.  %ResetRodent = 00
  24.  %ReadRodent = 03
  25.  %CountClicks = 05
  26.  %CountReleases = 06
  27.  
  28. '  MENU RETURN CODES (KEY PRESSED.)
  29.       %CR = 0:    %Esc = &H20:          %F1 = &H100:           %F2 = &H200
  30.             %PgUp = &H400:              %PgDn = &H600
  31.             %RArrow = &H800:            %LArrow = &HA00
  32.  
  33.  %CheckScreensSaved = %False
  34.  
  35.  DECLARE SUB SUPERMENU (string array,integer,integer,integer,string,integer)
  36.  DECLARE SUB BOXMESSAGE (integer, integer, integer)
  37.  DECLARE SUB QBox (integer, integer, integer, string, integer)
  38.  DECLARE SUB ENTERSTRING (string, integer, string)
  39.  DECLARE SUB ENTERYESNO (integer)
  40.  DECLARE SUB ENTERNUMBER (double, string, string)
  41.  DECLARE SUB Marker (string)
  42.  
  43.  EXTERNAL Footer$, CurrLine, LineGroup, Page%, NewRec, KeyField, PullDown
  44.  EXTERNAL OopsBeep$, InitPrt$, FontCode$, NextScrn2Pop, ScrnStackSize
  45.  EXTERNAL ScreenStack$ (), VideoSeg&, OrigL, OrigC,  ReverseLF$, NeedDCon
  46.  EXTERNAL MenuHelpLine$(), TopMargin, BottomMargin, Header$
  47.  EXTERNAL FldColor, ScrColor, GraphicsChrSetOn$, GraphicsChrSetOff$, BoldPrtOn$
  48.  EXTERNAL BoldPrtOff$, ItalicPrtOn$, ItalicPrtOff$, RegPrt$, FastPrt$
  49.  EXTERNAL WidePrt$, BigPrtOn$, BigPrtOff$, LQPrt$, DraftPrt$
  50.  EXTERNAL MicroPrtOn$, MicroPrtOff$, ElitePrt$, PicaPrt$
  51.  EXTERNAL LBPresses, LBReleases, LeftButtonPressed
  52.  EXTERNAL RightButtonPressed, MouseLin, MouseCol, FlashBox
  53.  
  54. '            _____________________________________________________
  55.  
  56.  
  57. SUB SCREENPUSH PUBLIC
  58.  
  59.  DEF SEG = VideoSeg&
  60.  
  61.  INCR NextScrn2Pop
  62.                               $IF %CheckScreensSaved
  63.  
  64.  FOR N = 1 TO 9: LPRINT ReverseLF$;: NEXT
  65.  LPRINT "SCREEN PUSHED: "; NextScrn2Pop
  66.  FOR N = 1 TO 9: LPRINT: NEXT
  67.                                        $ENDIF
  68.  
  69.  IF NextScrn2Pop =< ScrnStackSize THEN
  70.    ScreenStack$ (NextScrn2Pop) = PEEK$ (0, 4000)
  71.  ELSE
  72.    BSAVE RD$ + "SCRN_" + LTRIM$(STR$(NextScrn2Pop)), 0, 4000
  73.  END IF
  74.  
  75.  DEF SEG
  76.  END SUB                                                      REM PUSHSCREEN
  77. '            _____________________________________________________
  78.  
  79. SUB SCREENPOP PUBLIC
  80.  DEF SEG = VideoSeg&
  81.                                   $IF %CheckScreensSaved
  82.  FOR N = 1 TO 9: LPRINT ReverseLF$;: NEXT
  83.  LPRINT "                                SCREEN POPPED: "; NextScrn2Pop
  84.  FOR N = 1 TO 9: LPRINT: NEXT
  85.                                             $ENDIF
  86.  IF NextScrn2Pop < 1 THEN
  87.    FOR N = 1 TO 10: LOCATE 2*N, 5*N: PRINT "SCREEN STACK UNDERFLOW": NEXT
  88.  ELSEIF NextScrn2Pop =< ScrnStackSize THEN
  89.    POKE$ 0, ScreenStack$ (NextScrn2Pop)
  90.  ELSE
  91.    BLOAD RD$ + "SCRN_" + LTRIM$(STR$(NextScrn2Pop))
  92.  END IF
  93.  
  94.  DECR NextScrn2Pop
  95.  
  96.  DEF SEG
  97.  END SUB                                                      REM POPSCREEN
  98. '            _____________________________________________________
  99.  
  100.  
  101. SUB RestoreDOSScreen PUBLIC
  102.  NextScrn2Pop = 1
  103.  CALL SCREENPOP
  104.  LOCATE OrigL, 1
  105.  END SUB
  106.  
  107. ' =============================================================================
  108.  
  109. SUB PRINTLINE (L$) PUBLIC
  110.  LOCAL I, L0, C0, Att0
  111.  STATIC NL, Destination
  112.  %PageLength = 66
  113.  
  114.  IF INKEY$ = CHR$(27) THEN
  115.    L$ = "ABORTED BY USER"
  116.    IF Destination > 0 THEN CLOSE Destination
  117.    EXIT SUB
  118.  END IF
  119.  
  120. '                    Line comes in as a passed string. Increase line counter ...
  121.  INCR CurrLine
  122.  IF UCASE$ (L$) = "START" THEN '                    initialization of print job
  123.    NL = %PageLength - TopMargin - BottomMargin '           (these vars are o.k.)
  124.    IF Footer$ <> "" THEN DECR NL, 2
  125.    IF Header$ <> "" THEN DECR NL, 2
  126.    L0 = CSRLIN: C0 = POS: Att0 = SCREEN (CSRLIN, POS, 1)
  127.    CALL Out2Where (Destination)
  128.    LOCATE L0, C0: COLOR Att0 MOD 16, Att0 \ 16
  129.    IF Destination = 0 THEN L$ = "ABORTED BY USER": EXIT SUB
  130.    CurrLine = 1
  131.    Page% = 1
  132.    PRINT #32766, "" '              detect printer error before sending any data
  133.    PRINT #32766, InitPrt$ + FontCode$;
  134.    FOR I = 1 TO TopMargin: PRINT #32766,"" : NEXT
  135.  
  136. '   If page is full, or doesn't have room for LineGroup lines, print footer ...
  137.  
  138.  ELSEIF CurrLine + LineGroup > NL OR UCASE$ (L$) = "END" THEN
  139.     IF Footer$ <> "" THEN GOSUB PPrintFoot
  140.     INCR Page%: CurrLine = 1: PRINT #32766,  CHR$(12) '    ... form feed ...
  141.  
  142. '                       ... and if there's more to print, also a header ...
  143.  
  144.     IF UCASE$(L$) <> "END" AND Header$ <> "" THEN_
  145.       FOR I = 1 TO TopMargin: PRINT #32766,"" : NEXT: GOSUB PPrintHead
  146.  END IF
  147. '                                               now print the line and exit
  148.  IF UCASE$(L$) = "END" THEN
  149.    Page% = 0
  150.    PRINT #32766, InitPrt$;
  151.  ELSEIF UCASE$(L$) <> "START" THEN
  152.    PRINT #32766,  L$
  153.  END IF
  154.  EXIT SUB
  155.  
  156. PPrintHead:
  157.    PRINT #32766,  Header$;
  158.    IF INSTR (UCASE$ (RIGHT$(Header$,8)), "PAGE") THEN
  159.      PRINT #32766, Page%
  160.    ELSE
  161.      PRINT #32766,
  162.    END IF
  163.    PRINT #32766,
  164.    RETURN
  165.  
  166. PPrintFoot:
  167.    PRINT #32766,
  168.    PRINT #32766, Footer$;
  169.    IF INSTR (UCASE$ (RIGHT$(Footer$,8)), "PAGE") THEN
  170.      PRINT #32766, Page%
  171.    ELSE
  172.      PRINT #32766,
  173.    END IF
  174.    RETURN
  175.  
  176.      END SUB                                              REM PRINTLINE
  177.  
  178. '≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈
  179.  
  180.  
  181. SUB Out2Where (Destination) SHARED
  182.  LOCAL Fl$, Appending, MLine$
  183.  DIM MLine$ (8)
  184.  CALL SCREENPUSH
  185.  MLine$ (1) = "P SEND OUTPUT TO THE PRINTER"
  186.  MLine$ (2) = "D SEND OUTPUT TO A DISK FILE"
  187.  MLine$ (3) = "END"
  188.  Choice = 1
  189.  
  190.  CALL SUPERMENU (MLine$ (), 0, 30, Choice, "PRINT TO WHERE", Ky%)
  191.  
  192.  IF Ky% = %Esc THEN Destination = 0: CALL SCREENPOP: EXIT SUB
  193.  
  194.  Destination = 32766
  195.  SELECT CASE LEFT$ (MLine$ (Choice), 1)
  196.    CASE "P"
  197.      IF InitPrt$ = "" THEN
  198. Stpd:
  199.        DATA "PRINTER FORMATTING CODES HAVE BEEN REMOVED FROM MEMORY."
  200.        DATA ""
  201.        DATA "TO USE PRINTER PLEASE EXIT FORM THIS PROGRAM AND RE-START IT"
  202.        DATA END
  203.        RESTORE Stpd
  204.        CALL BOXMESSAGE (0,0,3)
  205.        Destination = 0: CALL SCREENPOP: EXIT SUB
  206.      END IF
  207.      OPEN "LPT1:" FOR OUTPUT AS 32766
  208.      CALL QBox (16,0,1,"CHECK THE PRINTER AND PRESS ANY KEY WHEN IT'S READY",0)
  209.      DO: LOOP UNTIL INSTAT
  210.      IF INKEY$ = CHR$(27) THEN
  211.        CLOSE 32766
  212.        Destination = 0
  213.        CALL SCREENPOP
  214.        EXIT SUB
  215.      END IF
  216.    CASE "D"
  217.      CALL QBox (16, 0, 1, "NAME OF FILE TO SEND OUTPUT TO", 20)
  218.      Fl$ = "PRINT.OUT"
  219.      Msg$ = "Caps"
  220.      COLOR FldColor MOD 16, FldColor \ 16
  221.      CALL ENTERSTRING (Fl$, 20, Msg$)
  222.      Fl$ = REMOVE$ (Fl$, ANY "?*|<>,+=/ ")
  223.      IF RTRIM$ (Fl$) = "" OR Msg$ = "ESC" _ 
  224.                               THEN Destination = 0: CALL SCREENPOP: EXIT SUB
  225.      IF DIR$ (Fl$) <> "" THEN
  226.        CALL SCREENPUSH
  227.        COLOR ScrColor MOD 16, ScrColor \ 16
  228.        CLS
  229.        MLine$ (1) = "A ADD ONTO END OF EXISTING FILE " + Fl$
  230.        MLine$ (2) = "E ERASE AND REPLACE EXISTING FILE " + Fl$
  231.        MLine$ (3) = "END"
  232.        CALL SUPERMENU (MLine$ (), 0, 30, Choice,_
  233.                     "File " + LCASE$ (Fl$) + "already exists", Ky%)
  234.        IF Choice = 0 THEN Destination = 0: CALL SCREENPOP: EXIT SUB
  235.        Appending = Choice - 2
  236.        CALL SCREENPOP
  237.      END IF
  238.      IF Appending THEN
  239.        OPEN Fl$ FOR APPEND AS #32766
  240.      ELSE
  241.        OPEN Fl$ FOR OUTPUT AS #32766
  242.      END IF
  243.  
  244.      CALL QBox (17, 0, 1,_
  245.           "REMOVE FORMATTING CODES AND MAKE A STRAIGHT ASCII FILE ?", 1)
  246.      StripEm = %False
  247.      CALL ENTERYESNO (StripEm)
  248.      IF StripEm THEN
  249.        BEEP: DELAY 1: BEEP: DELAY 1: BEEP
  250.        BigPrtOff$ = ""
  251.        BigPrtOn$ = ""
  252.        BoldPrtOff$ = ""
  253.        BoldPrtOn$ = ""
  254.        DraftPrt$ = ""
  255.        ElitePrt$ = ""
  256.        FastPrt$ = ""
  257.        GraphicsChrSetOff$ = ""
  258.        GraphicsChrSetOn$ = ""
  259.        InitPrt$ = ""
  260.        ItalicPrtOff$ = ""
  261.        ItalicPrtOn$ = ""
  262.        LQPrt$ = ""
  263.        MicroPrtOff$ = ""
  264.        MicroPrtOn$ = ""
  265.        PicaPrt$ = ""
  266.        RegPrt$ = ""
  267.        WidePrt$ = ""
  268.      END IF
  269.  END SELECT
  270.  CALL SCREENPOP
  271.  ERASE MLine$
  272.  END SUB
  273.  
  274. '≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈
  275.  
  276. FUNCTION GetAttr PUBLIC
  277.  DEF SEG = VideoSeg&
  278.  GetAttr = PEEK ((80*CSRLIN-80 + POS - 1) * 2) + 1
  279.  DEF SEG
  280.  END FUNCTION
  281.  
  282. '≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈
  283.  
  284. FUNCTION IsRodent PUBLIC    '     finds if you have a rodent and also resets it
  285.  REG %AX, %ResetRodent
  286.  CALL INTERRUPT &H33
  287.  IsRodent = REG(%AX) '                                          true if present
  288. END FUNCTION
  289.  
  290. '≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈
  291.  
  292. SUB Mouse(MV1, MV2, MV3, MV4) PUBLIC
  293.  REG %AX, MV1: REG %BX, MV2: REG %CX, MV3: REG %DX, MV4
  294.  CALL INTERRUPT &H33
  295.  MV1 = REG(%AX): MV2 = REG(%BX): MV3 = REG(%CX): MV4 = REG(%DX)
  296.  
  297. END SUB
  298. ' _________________________________________________________________________
  299.  
  300. FUNCTION MouseClicked PUBLIC
  301.  LOCAL MC, X, Y
  302.  IF NeedDCon THEN
  303.    CALL Mouse (%ReadRodent, MC, X, Y)
  304.    MouseClicked = MC
  305.  ELSE
  306.    MouseClicked = 0
  307.  END IF
  308. END FUNCTION
  309. ' _________________________________________________________________________
  310.  
  311. SUB GetMouse SHARED PUBLIC
  312.  
  313. ' %CountReleases = 6 ' / BX=0  (ON RETURN, BX = NUMBER OF REL) READ INTO BX
  314.  
  315.  REG (%AX), %CountClicks
  316.  REG (%BX), %LtButton
  317.  CALL INTERRUPT &H33
  318.  LBPresses = LBPresses + REG (%BX)
  319.  
  320.  REG (%AX), %CountReleases
  321.  REG (%BX), %LtButton
  322.  CALL INTERRUPT &H33
  323.  LeftButtonReleases = LeftButtonReleases + REG (%BX)
  324.  
  325.  REG (%AX), %ReadRodent
  326.  CALL INTERRUPT &H33
  327.  LeftButtonPressed = (REG (%BX) = 1)
  328.  RightButtonPressed = (REG (%BX) > 1)
  329.  MouseCol = REG (%CX) \ 8
  330.  MouseLin = REG (%DX) \ 8
  331.  
  332. END SUB
  333.  
  334. ' _________________________________________________________________________
  335.  
  336. SUB MouseControl (HMick, VMick) PUBLIC
  337.   CALL SCREENPUSH
  338.   IF HMick = 0 THEN
  339.     CALL QBox (11, 0, 1, "How many mickeys / 8 pixels HORIZONTAL ? ", 2)
  340.     A# = 12
  341.     CALL ENTERNUMBER (A#, "##", Msg$)
  342.     IF Msg$ <> "CR" THEN EXIT SUB
  343.     HMick = A#
  344.   END IF
  345.   IF VMick = 0 THEN
  346.     CALL QBox (13, 32, 1, "How many mickeys / 8 pixels VERTICAL ? ", 2)
  347.     A# = 32
  348.     CALL ENTERNUMBER (A#, "##", Msg$)
  349.     IF Msg$ <> "CR" THEN EXIT SUB
  350.     VMick = A#
  351.   END IF
  352.   REG %AX, &H000F '               AX = 000Fh
  353.   REG %CX, HMick '                   CX = number of mickeys per 8 pixels horiz
  354.   REG %DX, VMick '                   DX = number of mickeys per 8 pixels vert
  355.   CALL INTERRUPT &H33 '         INT 33 - MS MOUSE - DEFINE MICKEY/PIXEL RATIO
  356.   FlashBox = %True
  357.   CALL QBox (21, 60, 1, "MOUSE DRIVER RESET", 0)
  358.   DELAY 1
  359.   CALL SCREENPOP
  360. END SUB
  361.  
  362. FUNCTION GetCurrentDrive$ PUBLIC
  363.    REG %AX, &H1900
  364.    CALL INTERRUPT &H21
  365.    GetCurrentDrive$ = CHR$ ((REG (%AX) AND &B00001111) + 65) + ":"
  366.  
  367. END FUNCTION
  368.  
  369. FUNCTION GetCurrentDir$ (Drv$) PUBLIC
  370.    STATIC Dummy$
  371.    Dummy$ = SPACE$ (64)
  372.  
  373.    REG %AX, &H4700
  374.  
  375.    IF Drv$ = "" THEN
  376.      REG %DX, 0 '                                 for default drive
  377.    ELSE
  378.      REG %DX, (ASC(UCASE$(Drv$))-64)
  379.    END IF
  380.  
  381.    REG %DS, STRSEG (Dummy$)
  382.    REG %SI, STRPTR (Dummy$)
  383.  
  384.    CALL INTERRUPT &H21
  385.  
  386.    GetCurrentDir$ = "\" + EXTRACT$ (Dummy$, CHR$(0))
  387.  
  388. END FUNCTION '             ==========================        GetCurrentDir$ ()
  389.  
  390. FUNCTION GetFreeSpace! (Drv$) PUBLIC
  391.    IF Drv$ = "" THEN
  392.      REG %DX, 0 '     for default drive
  393.    ELSE
  394.      REG %DX, (ASC(UCASE$(Drv$))-64)
  395.    END IF
  396.    REG %AX, &H3600  '     dos function number &H36 into AH
  397.    CALL INTERRUPT &H21
  398.    GetFreeSpace! = CSNG (REG(%BX)) * REG (%CX) * REG (%AX)
  399. '                     free clusters  * byt/sect  * sect/cluster
  400.  
  401. END FUNCTION '                    ----------
  402.  
  403. FUNCTION ReadParamFor (A$) PUBLIC ' this reads parameters from the command tail
  404.  LOCAL L, N
  405.  L = INSTR (COMMAND$, A$)
  406.  IF L THEN
  407.    N = VAL ("&H"+MID$ (COMMAND$, L + 5, 2))
  408.    IF N THEN ReadParamFor = N
  409.  END IF
  410.  END FUNCTION '                    ----------
  411.  
  412. SUB ClearLine PUBLIC
  413.  
  414.  LOCAL CLL0, CLC0
  415.  
  416.  CLL0 = CSRLIN
  417.  CLC0 = POS
  418.  PRINT STRING$ ((81-CLC0)," ");
  419.  LOCATE CLL0, CLC0
  420.  
  421.  END SUB '                    ----------  
  422.  
  423. ' ============================================================================
  424.  
  425.  
  426. SUB DirFirst (F$, FileSize&, DateCode&, TimeCode&) PUBLIC
  427.  
  428.  LOCAL DTASeg&, AttrOffset&, FlNOffset&, SearchErr, FlN$, N
  429.  
  430.  FlN$ = F$ + CHR$(0)
  431.  REG %DS, STRSEG (FlN$)
  432.  REG %DX, STRPTR (FlN$)
  433.  REG %CX, &H17
  434.  REG %AX, &H4E00
  435.  CALL INTERRUPT &H21
  436.  SearchErr = REG(%AX)
  437.  IF SearchErr THEN
  438.     F$ = ""
  439.     EXIT SUB
  440.  END IF
  441.  
  442.  REG %AX, &H2F00
  443.  
  444.     CALL INTERRUPT &H21
  445.  
  446.  DTAseg& = REG(%ES)
  447.  AttrOffset& = REG(%BX) + &H15
  448.  FlNOffset& = REG(%BX) + &H1E
  449.  TimeOffset& = REG(%BX) + &H16
  450.  DateOffset& = REG(%BX) + &H18
  451.  SizeOffset& = REG(%BX) + &H1A
  452.  
  453.  FlN$ = ""
  454.  DEF SEG = DTAseg&
  455.  N = 0
  456.  
  457.  DO UNTIL PEEK (FlNOffset& + N) = 0 '          read the ASCIIZ file-name string
  458.    FlN$ = FlN$ + CHR$ (PEEK (FlNOffset& + N))
  459.    INCR N
  460.  LOOP
  461.  
  462.  IF (PEEK(AttrOffset&) AND 16) = 16 THEN '        bracket if a subdirectory
  463.     FlN$ = "<"+FlN$+">"
  464.  END IF
  465.  
  466.  FileSize& = CVL (PEEK$ (SizeOffset&, 4))
  467.  DateCode& =  PEEK (DateOffset&) + &H100 * PEEK (DateOffset& + 1)
  468.  TimeCode& =  PEEK (TimeOffset&) + &H100 * PEEK (TimeOffset& + 1)
  469.  
  470.  DEF SEG
  471.  
  472.  F$ = FlN$
  473.  
  474.  END SUB
  475.  
  476. '                        ===========================
  477.  
  478.  
  479.  
  480.  SUB DirNext (F$, FileSize&, DateCode&, TimeCode&) PUBLIC
  481.  
  482.  LOCAL FlN$, DTAseg&, FlNOffset&, AttrOffset&, N
  483.  
  484.  REG %AX, &H4F00
  485.  CALL INTERRUPT &H21
  486.  IF REG(%AX) = 18 THEN
  487.     F$ = ""
  488.     EXIT SUB
  489.  END IF
  490.  REG %AX, &H2F00
  491.  CALL INTERRUPT &H21
  492.  DTAseg& = REG(%ES)
  493.  AttrOffset& = REG(%BX) + 21
  494.  FlNOffset& = REG(%BX) + &H1E
  495.  TimeOffset& = REG(%BX) + &H16
  496.  DateOffset& = REG(%BX) + &H18
  497.  SizeOffset& = REG(%BX) + &H1A
  498.  
  499.  FlN$ = ""
  500.  DEF SEG = DTAseg&
  501.  
  502.  DO UNTIL PEEK (FlNOffset& + N) = 0
  503.    FlN$ = FlN$ + CHR$(PEEK(FlNOffset& + N))
  504.    INCR N
  505.  LOOP
  506.  
  507.  IF (PEEK(AttrOffset&) AND 16) = 16 THEN
  508.     FlN$ = "<"+FlN$+">" '                  subdirs will come back w/ brackets
  509.  END IF
  510.  
  511.  FileSize& = CVL (PEEK$ (SizeOffset&, 4))
  512.  DateCode& =  PEEK (DateOffset&) + &H100 * PEEK (DateOffset& + 1)
  513.  TimeCode& =  PEEK (TimeOffset&) + &H100 * PEEK (TimeOffset& + 1)
  514.  DEF SEG
  515.  F$ = FlN$
  516.  
  517. END SUB
  518.  
  519. '                   ========================================
  520.  
  521.  
  522. FUNCTION DecodeDate$ (DateCode&) PUBLIC
  523.  LOCAL M, D, Y
  524.  Y = DateCode&\512
  525.  M = (DateCode& MOD 512) \ 32
  526.  D = DateCode& MOD 32
  527.  DecodeDate$ = LTRIM$ (STR$ (M)) + "-" +_
  528.                    STRING$ (1 + (D > 9), "0") + LTRIM$ (STR$ (D)) + "-" +_
  529.                                LTRIM$ (STR$ (Y + 80))
  530.  
  531. END FUNCTION '         ============================      DecodeDate$ ()
  532.  
  533.  
  534. FUNCTION DecodeTime$ (TimeCode&) PUBLIC
  535.  LOCAL H, H24, M
  536.  H24 = INT(TimeCode&\2048)
  537.  IF H24 > 12 THEN
  538.     H = H24 - 12
  539.     pm = %True
  540.  ELSE
  541.     H = H24
  542.     pm = %False
  543.  END IF
  544.  IF H = 0 THEN H = 12
  545.  M = (TimeCode&-(CLNG(H24)*2048))\32
  546.  
  547.  DecodeTime$ = STRING$ (1 + (H > 9), " ") + LTRIM$ (STR$ (H)) + ":" +_
  548.                    STRING$ (1 + (M > 9), "0") + LTRIM$ (STR$ (M)) +_
  549.                                MID$ (" pm am", pm*3+4, 3)
  550. END FUNCTION '         ============================      DecodeTime$ ()
  551.  
  552.  
  553. FUNCTION EXIST (F$) PUBLIC
  554.  
  555.  LOCAL SearchErr, FZ$
  556.  
  557.  REG %AX, &H2F00
  558.  CALL INTERRUPT &H21 '                     GET DOS'S D.T.A.
  559. '                              (in FEXIST.BOX Barry gets out the DTA addr but
  560. '                                 never uses it. It's ES:BX.)
  561.  FZ$ = F$ + CHR$(0)
  562.  REG %DS, STRSEG (FZ$)
  563.  REG %DX, STRPTR (FZ$)
  564.  REG %CX, &H7
  565.  REG %AX, &H4E00
  566.  CALL INTERRUPT &H21
  567.  SearchErr = REG(%AX)
  568.  SELECT CASE SearchErr
  569.    CASE 2, 3, 15, 18
  570.      EXIST = 0
  571.    CASE ELSE
  572.      EXIST = -1
  573.  END SELECT
  574.  DEF SEG
  575.  
  576. END Function '            ==================        EXIST ()
  577.  
  578.  
  579. FUNCTION FQFileSpec$ (A$) PUBLIC
  580.  
  581.  LOCAL CurrentDir$, CurrentDrv$             ' Of course there's a DOS function
  582.  CurrentDrv$ = GetCurrentDrive$             ' that does something like this --
  583.  CurrentDir$ = GetCurrentDir$ ("")          ' maybe exactly this! I never did
  584.                                             ' try it out. So this may be the
  585.  A$ = REMOVE$ (A$, " ")                     ' hard way!
  586.  IF INSTR (A$, ANY "^/,<>+()|"+CHR$(34)) THEN
  587.    FQFileSpec$ = "": EXIT FUNCTION
  588.  END IF
  589.  
  590.  SELECT CASE INSTR (A$, ":")
  591.    CASE 0
  592.      IF INSTR (A$, "\") THEN
  593.        A$ = CurrentDrv$ + A$
  594.      ELSE
  595.        A$ = CurrentDrv$ + CurrentDir$ +"\"+ A$
  596.      END IF
  597.      EXIT SELECT
  598.    CASE 2
  599.      IF INSTR (A$, "\") = %False THEN
  600.        CurrentDir$ = GetCurrentDir$ (LEFT$(A$,1))
  601.      END IF
  602.      EXIT SELECT
  603.    CASE ELSE
  604.      PLAY "O0 C64": FQFileSpec$ = "": EXIT FUNCTION
  605.  END SELECT
  606.  IF INSTR (A$, "\") = %False THEN
  607.    IF RIGHT$ (A$, 1) = ":" THEN
  608.      A$ = A$ + CurrentDir$ + "\"
  609.    ELSEIF CurrentDir$ = "\" THEN
  610.      A$ = LEFT$ (A$, 2) + "\" + MID$ (A$, 3)
  611.    ELSE
  612.      A$ = LEFT$ (A$, 2) + CurrentDir$ + "\" + MID$ (A$, 3)
  613.    END IF
  614.  END IF
  615.  
  616.  IF RIGHT$ (A$, 1) = "\" THEN A$ = A$ + "*.*"
  617.  
  618.  REPLACE "\\" WITH "\" IN A$
  619.  FQFileSpec$ = A$
  620.  
  621. END FUNCTION '                 =========                      FQFileSpec$
  622.  
  623.  FUNCTION Cen$ (A$) PUBLIC
  624.    Cen$ = SPACE$ (40 - LEN (A$)\2) + A$
  625.  END FUNCTION
  626.  
  627.  FUNCTION CVU& (UnsignedNumRepresentation$) PUBLIC
  628.    CVU& = ASCII (LEFT$ (UnsignedNumRepresentation$, 1)) + _
  629.               256 *  ASCII (MID$ (UnsignedNumRepresentation$, 2, 1))
  630.  END FUNCTION
  631.  
  632.  FUNCTION MKU$ (Unsigned&) PUBLIC
  633.    Unsigned& = ABS (Unsigned&)
  634.    IF Unsigned& > 65535 THEN_
  635.               ErrorMessage$ = "APLIB: Unsigned int. Overflow": ERROR 905
  636.    MKU$ = CHR$ (Unsigned& MOD 256) + CHR$ (Unsigned& \ 256)
  637.  END FUNCTION
  638.  
  639. SUB BufferStuffer (M$) PUBLIC
  640.  IF LEN (M$) > 15 THEN PLAY "O2 E32 P8 O1 C4": M$ = "COMMAND"+CHR$(255)+"2 LONG"
  641.  L = LEN (M$)
  642.  DEF SEG = 0
  643.  POKE 1050, 30
  644.  POKE 1052, 30 + 2 * L
  645.  FOR I = 1 TO L
  646.    POKE 1052 + 2*I, ASCII (MID$ (M$,I,1))
  647.  NEXT
  648. END SUB
  649.  
  650. FUNCTION DosVer! PUBLIC
  651.  REG %AX, &H3000
  652.  CALL INTERRUPT &H21
  653.  DosVer! = REG (%AX) MOD 256 + (REG (%AX) \ 256) / 100
  654. END FUNCTION
  655.  
  656.